home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / demostuf / box1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-07-25  |  7.2 KB  |  440 lines
  1. program xbox1;
  2. {
  3.     Texture-mapped box rotating around x-axis
  4.     - by Bjarke Viksφe
  5.     apr 1994
  6.  
  7.   THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  8.   YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  9.   E-MAIL ME AT: dat92230@rix02.lyngbyes.dk IN 1994 FOR CHAT AND CODE.
  10. }
  11.  
  12. {$A+,B-,G+,E+,I+,N-,X+}
  13.  
  14. uses
  15.     DEMOINIT, ILBM256;
  16.  
  17. (*{$DEFINE DEBUG}*)
  18.  
  19. const
  20.     ANTAL_COORDS = 4;
  21.     LOGO_HEIGHT = 63;
  22.     SCR_POS = WIDTH*70;
  23.  
  24. type
  25.     coordbuffer = array[1..4*3] of integer;
  26.     midarray = array[1..320] of word;
  27.  
  28. var
  29.     v1 : word;
  30.     sin1,cos1 : integer;
  31.     sinustabel : array [0..639] of integer;
  32.  
  33.     xkoord,ykoord,zkoord : integer;
  34.     coords : coordbuffer;
  35.     cbuffer : coordbuffer;
  36.  
  37.     buffer : pScreen;
  38.     logo : pScreen;
  39.     midtabeller : array[1..160] of ^midarray;
  40.  
  41.     midxtabel : array[0..200] of word;
  42.     midytabel : array[0..200] of word;
  43.     ytabel320 : array[0..200] of word;
  44.  
  45. const
  46.     display1 : word = $0000;
  47.     display2 : word = $4000;
  48.     display3 : word = $8000;
  49.  
  50.  
  51. (*------------------------------------------------*)
  52.  
  53. procedure CalcInBetweens;
  54. var
  55.     i,j : integer;
  56.     x1,xadd : real;
  57. begin
  58.     for i:=161 to 320 do begin
  59.         GetMem(midtabeller[i-160],SizeOf(word)*i);
  60.         x1:=0.0;
  61.         xadd:=(320.0)/(i);
  62.         for j:=1 to i do begin
  63.             midtabeller[i-160]^[j]:=round(x1);
  64.             x1:=x1+xadd;
  65.         end;
  66.     end;
  67. end;
  68.  
  69.  
  70. procedure SetupSinus;
  71. var
  72.     i : integer;
  73.     v, vadd : real;
  74. begin
  75.     v:=0.0;
  76.     vadd:=(2.0*pi/512.0);
  77.     for i:=0 to 639 do begin
  78.         sinustabel[i]:=round(sin(v)*32767);
  79.         v:=v+vadd;
  80.     end;
  81. end;
  82.  
  83. procedure InitCoords;
  84. const
  85.     X = 440;
  86.     Y = 60;
  87.     Z = 60;
  88. begin
  89.     coords[1]:=-X; coords[2]:=Y; coords[3]:=Z;
  90.     coords[4]:=-X; coords[5]:=Y; coords[6]:=-Z;
  91.     coords[7]:=-X; coords[8]:=-Y; coords[9]:=-Z;
  92.     coords[10]:=-X; coords[11]:=-Y; coords[12]:=Z;
  93. end;
  94.  
  95. procedure InitDemo;
  96. var
  97.     i : integer;
  98. begin
  99.     ClearWholeScreen;
  100.     SetupSinus;
  101.     InitCoords;
  102.     New(buffer);
  103.     fillchar(buffer^,SizeOf(buffer^),0);
  104.     New(logo);
  105.     LoadPix(logo,'PARASIT2.LBM');
  106.     SetCMAP;
  107.     CalcInBetweens;
  108.     for i:=0 to 200 do ytabel320[i]:=i*320;
  109.     v1:=0;
  110. end;
  111.  
  112. procedure UninitDemo;
  113. var
  114.     i : integer;
  115. begin
  116.     Dispose(logo);
  117.     Dispose(buffer);
  118.     for i:=161 to 320 do FreeMem(midtabeller[i-160],SizeOf(word)*i);
  119. end;
  120.  
  121.  
  122. (*------------------------------------------------*)
  123.  
  124. procedure SwapDisplay;
  125. var
  126.     temp : word;
  127. begin
  128.     temp:=display3;
  129.     display3:=display2;
  130.     display2:=display1;
  131.     display1:=temp;
  132.     SetAddress(Ptr(SEGA000,display2));
  133. end;
  134.  
  135.  
  136. procedure CalcVinkel;
  137. begin
  138.     sin1:=sinustabel[v1];
  139.     cos1:=sinustabel[v1+128];
  140.     v1:=(v1+3) AND 511;
  141. end;
  142.  
  143. procedure RotateAllCoords; assembler;
  144. var
  145.     n : integer;
  146. asm
  147.     mov    ax,ds
  148.     mov    es,ax
  149.     lea    si,coords
  150.     lea    di,cbuffer
  151.     mov    n,ANTAL_COORDS
  152.     cld
  153. @loop:
  154.     lodsw
  155.     mov    xkoord,ax
  156.     lodsw
  157.     mov    ykoord,ax
  158.     lodsw
  159.     mov    zkoord,ax
  160.  
  161.     mov    ax,ykoord               {rotate around Y-axis}
  162.     push    ax
  163.     imul    Cos1
  164.     add    ax,ax
  165.     adc    dx,dx
  166.     mov    bx,dx
  167.     mov    ax,zkoord
  168.     imul    Sin1
  169.     add    ax,ax
  170.     adc    dx,dx
  171.     sub    bx,dx
  172.     mov    ykoord,bx
  173.     pop    ax
  174.     imul    Sin1
  175.     add    ax,ax
  176.     adc    dx,dx
  177.     mov    bx,dx
  178.     mov    ax,zkoord
  179.     imul    Cos1
  180.     add    ax,ax
  181.     adc    dx,dx
  182.     add    bx,dx
  183.     mov    zkoord,bx
  184.  
  185.     add    bx,800
  186.     and    bx,bx
  187.     jnz    @zero
  188.     mov    bl,1
  189. @zero:
  190.  
  191.     mov        ax,xkoord
  192.     cwd
  193.     mov        dl,ah
  194.     mov        ah,al
  195.     xor        al,al
  196.     idiv        bx
  197.     stosw
  198.  
  199.     mov        ax,ykoord
  200.     cwd
  201.     mov        dl,ah
  202.     mov        ah,al
  203.     xor        al,al
  204.     idiv        bx
  205.     add        ax,28
  206.     stosw
  207.  
  208.     dec        n
  209.     jne        @loop
  210. end;
  211.  
  212.  
  213. (*------------------------------------------------*)
  214.  
  215. procedure CalcSlope(a1,a2,n : integer; tabel : pointer);
  216. var
  217.     dela : longint;
  218. begin
  219.     if (n<1) then exit;
  220.     dela := (a2-a1)*($10000 DIV (n));
  221.     asm
  222.         les    di,tabel
  223.         mov    si,n
  224.         mov    ax,a1
  225.         xor    dx,dx
  226.         mov    cx,WORD PTR dela
  227.         mov    bx,WORD PTR dela+2
  228.         cld
  229. @loop1:
  230.         add    dx,cx
  231.         adc    ax,bx
  232.         stosw
  233.         dec    si
  234.         jnz    @loop1
  235.     end;
  236. end;
  237.  
  238.  
  239. (*------------------------------------------------*)
  240.  
  241. procedure DrawScreen;
  242.  procedure CopyBuffer(yoffset : word); assembler;
  243.  asm
  244.     push    ds
  245.     mov    es,SEGA000
  246.     mov    di,display1
  247.     add    di,SCR_POS
  248.     lds    si,buffer
  249.     add    si,yoffset
  250.     mov    cx,(WIDTH*60)/4
  251.     cld
  252.     {rep movsd} DB $F3,$66,$A5
  253.     pop    ds
  254.  end;
  255. begin
  256.     SetBitplanes(4);
  257.     CopyBuffer($0000);
  258.     SetBitplanes(8);
  259.     CopyBuffer($4000);
  260.     SetBitplanes(1);
  261.     CopyBuffer($8000);
  262.     SetBitplanes(2);
  263.     CopyBuffer($C000);
  264. end;
  265.  
  266. procedure ClearTopBottom; assembler;
  267. const
  268.     toplines = 8;
  269.     bottomlines = 8;
  270.     downoffset = 48*WIDTH;
  271. asm
  272.     cld
  273.     {xor    eax,eax} DB $66,$33,$C0
  274.     les    di,buffer
  275.     mov    dx,(WIDTH*TOPLINES)/4
  276.     mov    cx,dx
  277.     {rep stosd} DB $F3,$66,$AB
  278.     les    di,buffer
  279.     add    di,$4000
  280.     mov    cx,dx
  281.     {rep stosd} DB $F3,$66,$AB
  282.     les    di,buffer
  283.     add    di,$8000
  284.     mov    cx,dx
  285.     {rep stosd} DB $F3,$66,$AB
  286.     les    di,buffer
  287.     add    di,$C000
  288.     mov    cx,dx
  289.     {rep stosd} DB $F3,$66,$AB
  290.  
  291.     les    di,buffer
  292.     mov    dx,(WIDTH*BOTTOMLINES)/4
  293.     add    di,downoffset
  294.     mov    cx,dx
  295.     {rep stosd} DB $F3,$66,$AB
  296.     les    di,buffer
  297.     add    di,downoffset+$4000
  298.     mov    cx,dx
  299.     {rep stosd} DB $F3,$66,$AB
  300.     les    di,buffer
  301.     add    di,downoffset+$8000
  302.     mov    cx,dx
  303.     {rep stosd} DB $F3,$66,$AB
  304.     les    di,buffer
  305.     add    di,downoffset+$C000
  306.     mov    cx,dx
  307.     {rep stosd} DB $F3,$66,$AB
  308. end;
  309.  
  310.  
  311. (*------------------------------------------------*)
  312.  
  313. procedure PaintLine(x : integer; midtabel : pointer;
  314.                         yoffset,logooffset : word); assembler;
  315. const
  316.     offadd : array[0..3] of word = ($8000,$C000,$0000,$4000);
  317. asm
  318.     push    ds
  319.     push    bp
  320.     les    di,buffer
  321.     add    di,yoffset
  322.     mov    bx,x
  323.     add    bx,160
  324.     and    bx,3
  325.     shl    bx,1
  326.     add    di,[OFFSET offadd+bx]
  327.     mov    ax,x
  328.     add    ax,160
  329.     sar    ax,2
  330.     add    di,ax
  331.  
  332.     mov    ax,WORD PTR logo+2
  333.     {mov    fs,ax} DB $8E,$E0
  334.     mov    dx,WORD PTR logo
  335.     add    dx,logooffset
  336.     lds    si,midtabel
  337.     mov    cx,x
  338.     neg    cx
  339.     shl    cx,1
  340.     cld
  341.     mov    bp,$4000
  342. @loop:
  343.     lodsw
  344.     mov    bx,dx
  345.     add    bx,ax
  346.     DB FS; mov    al,[bx]
  347.     mov    [es:di],al
  348.     add    di,bp
  349.     jno    @nooverflow
  350.     inc    di
  351. @nooverflow:
  352.     loop    @loop
  353.     pop    bp
  354.     pop    ds
  355. end;
  356.  
  357.  
  358. (*------------------------------------------------*)
  359.  
  360. procedure DrawFace(x2,y2,x1,y1 : integer);
  361. var
  362.     i : integer;
  363.     x,yoffset,logooffset : word;
  364.     height : integer;
  365. begin
  366.     height:=y2-y1;
  367.     if (height<=1) then exit;
  368.     if y1<0 then halt;
  369.     CalcSlope(x1,x2,height,@midxtabel);
  370.     CalcSlope(0,LOGO_HEIGHT,height,@midytabel);
  371.  
  372.     {mulu 320 to all values in "midytabel"}
  373.     asm
  374.         mov    ax,ds
  375.         mov    es,ax
  376.         lea    di,midytabel
  377.         lea    si,ytabel320
  378.         mov    cx,height
  379.         cld
  380. @loop:
  381.         mov    bx,[di]
  382.         shl    bx,1
  383.         mov    ax,[si+bx]
  384.         stosw
  385.         loop    @loop
  386.     end;
  387.  
  388.     logooffset:=0;
  389.     yoffset:=ytabel[y1];
  390.     for i:=0 to height-1 do begin
  391.         x:=midxtabel[i];
  392.         PaintLine(x,@midtabeller[((-x) shl 1)-160]^,yoffset,midytabel[i]);
  393.         inc(yoffset,WIDTH);
  394.         inc(logooffset,320);
  395.     end;
  396. end;
  397.  
  398.  
  399. (*------------------------------------------------*)
  400.  
  401. procedure RunOnce;
  402. var
  403.     i : integer;
  404. begin
  405.     SwapDisplay;
  406.     while retraces=0 do ;
  407.     retraces:=0;
  408. {$IFDEF DEBUG}
  409.     i:=retraces;
  410.     while retraces=i do ;
  411.     SetRGB(0,30,0,0);
  412. {$ENDIF}
  413.  
  414.     ClearTopBottom;
  415.     CalcVinkel;
  416.     RotateAllCoords;
  417.     DrawFace(cbuffer[1],cbuffer[2],cbuffer[3],cbuffer[4]);
  418.     DrawFace(cbuffer[3],cbuffer[4],cbuffer[5],cbuffer[6]);
  419.     DrawFace(cbuffer[5],cbuffer[6],cbuffer[7],cbuffer[8]);
  420.     DrawFace(cbuffer[7],cbuffer[8],cbuffer[1],cbuffer[2]);
  421.     DrawScreen;
  422.  
  423. {$IFDEF DEBUG}
  424.     SetRGB(0,0,0,0);
  425. {$ENDIF}
  426. end;
  427.  
  428.  
  429. begin
  430.     OpenScreen;
  431.     Screen_Off;
  432.     InitDemo;
  433.     SetAllInterrupts;
  434.     Screen_On;
  435.     repeat RunOnce until Key='e';
  436.     RestoreAllInterrupts;
  437.     UninitDemo;
  438.     CloseScreen;
  439. end.
  440.